home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / perl / os2perl / dolist.c < prev    next >
C/C++ Source or Header  |  1991-06-11  |  44KB  |  1,811 lines
  1. /* $RCSfile: dolist.c,v $$Revision: 4.0.1.2 $$Date: 91/06/10 01:22:15 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    dolist.c,v $
  9.  * Revision 4.0.1.2  91/06/10  01:22:15  lwall
  10.  * patch10: //g only worked first time through
  11.  *
  12.  * Revision 4.0.1.1  91/06/07  10:58:28  lwall
  13.  * patch4: new copyright notice
  14.  * patch4: added global modifier for pattern matches
  15.  * patch4: // wouldn't use previous pattern if it started with a null character
  16.  * patch4: //o and s///o now optimize themselves fully at runtime
  17.  * patch4: $` was busted inside s///
  18.  * patch4: caller($arg) didn't work except under debugger
  19.  *
  20.  * Revision 4.0  91/03/20  01:08:03  lwall
  21.  * 4.0 baseline.
  22.  *
  23.  */
  24.  
  25. #include "EXTERN.h"
  26. #include "perl.h"
  27.  
  28.  
  29. #ifdef BUGGY_MSC
  30.  #pragma function(memcmp)
  31. #endif /* BUGGY_MSC */
  32.  
  33. int
  34. do_match(str,arg,gimme,arglast)
  35. STR *str;
  36. register ARG *arg;
  37. int gimme;
  38. int *arglast;
  39. {
  40.     register STR **st = stack->ary_array;
  41.     register SPAT *spat = arg[2].arg_ptr.arg_spat;
  42.     register char *t;
  43.     register int sp = arglast[0] + 1;
  44.     STR *srchstr = st[sp];
  45.     register char *s = str_get(st[sp]);
  46.     char *strend = s + st[sp]->str_cur;
  47.     STR *tmpstr;
  48.     char *myhint = hint;
  49.     int global;
  50.     int safebase;
  51.  
  52.     hint = Nullch;
  53.     if (!spat) {
  54.     if (gimme == G_ARRAY)
  55.         return --sp;
  56.     str_set(str,Yes);
  57.     STABSET(str);
  58.     st[sp] = str;
  59.     return sp;
  60.     }
  61.     global = spat->spat_flags & SPAT_GLOBAL;
  62.     safebase = (gimme == G_ARRAY) || global;
  63.     if (!s)
  64.     fatal("panic: do_match");
  65.     if (spat->spat_flags & SPAT_USED) {
  66. #ifdef DEBUGGING
  67.     if (debug & 8)
  68.         deb("2.SPAT USED\n");
  69. #endif
  70.     if (gimme == G_ARRAY)
  71.         return --sp;
  72.     str_set(str,No);
  73.     STABSET(str);
  74.     st[sp] = str;
  75.     return sp;
  76.     }
  77.     --sp;
  78.     if (spat->spat_runtime) {
  79.     nointrp = "|)";
  80.     sp = eval(spat->spat_runtime,G_SCALAR,sp);
  81.     st = stack->ary_array;
  82.     t = str_get(tmpstr = st[sp--]);
  83.     nointrp = "";
  84. #ifdef DEBUGGING
  85.     if (debug & 8)
  86.         deb("2.SPAT /%s/\n",t);
  87. #endif
  88.     if (spat->spat_regexp) {
  89.         regfree(spat->spat_regexp);
  90.         spat->spat_regexp = Null(REGEXP*);    /* crucial if regcomp aborts */
  91.     }
  92.     spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
  93.         spat->spat_flags & SPAT_FOLD);
  94.     if (!spat->spat_regexp->prelen && lastspat)
  95.         spat = lastspat;
  96.     if (spat->spat_flags & SPAT_KEEP) {
  97.         if (spat->spat_runtime)
  98.         arg_free(spat->spat_runtime);    /* it won't change, so */
  99.         spat->spat_runtime = Nullarg;    /* no point compiling again */
  100.         scanconst(spat, t, tmpstr->str_cur);
  101.         hoistmust(spat);
  102.         if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
  103.         curcmd->c_flags &= ~CF_OPTIMIZE;
  104.         opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
  105.         }
  106.     }
  107.     if (global) {
  108.         if (spat->spat_regexp->startp[0]) {
  109.         s = spat->spat_regexp->endp[0];
  110.         }
  111.     }
  112.     else if (!spat->spat_regexp->nparens)
  113.         gimme = G_SCALAR;            /* accidental array context? */
  114.     if (regexec(spat->spat_regexp, s, strend, s, 0,
  115.       srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
  116.       safebase)) {
  117.         if (spat->spat_regexp->subbase || global)
  118.         curspat = spat;
  119.         lastspat = spat;
  120.         goto gotcha;
  121.     }
  122.     else {
  123.         if (gimme == G_ARRAY)
  124.         return sp;
  125.         str_sset(str,&str_no);
  126.         STABSET(str);
  127.         st[++sp] = str;
  128.         return sp;
  129.     }
  130.     }
  131.     else {
  132. #ifdef DEBUGGING
  133.     if (debug & 8) {
  134.         char ch;
  135.  
  136.         if (spat->spat_flags & SPAT_ONCE)
  137.         ch = '?';
  138.         else
  139.         ch = '/';
  140.         deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
  141.     }
  142. #endif
  143.     if (!spat->spat_regexp->prelen && lastspat)
  144.         spat = lastspat;
  145.     t = s;
  146.     play_it_again:
  147.     if (global && spat->spat_regexp->startp[0])
  148.         s = spat->spat_regexp->endp[0];
  149.     if (myhint) {
  150.         if (myhint < s || myhint > strend)
  151.         fatal("panic: hint in do_match");
  152.         s = myhint;
  153.         if (spat->spat_regexp->regback >= 0) {
  154.         s -= spat->spat_regexp->regback;
  155.         if (s < t)
  156.             s = t;
  157.         }
  158.         else
  159.         s = t;
  160.     }
  161.     else if (spat->spat_short) {
  162.         if (spat->spat_flags & SPAT_SCANFIRST) {
  163.         if (srchstr->str_pok & SP_STUDIED) {
  164.             if (screamfirst[spat->spat_short->str_rare] < 0)
  165.             goto nope;
  166.             else if (!(s = screaminstr(srchstr,spat->spat_short)))
  167.             goto nope;
  168.             else if (spat->spat_flags & SPAT_ALL)
  169.             goto yup;
  170.         }
  171. #ifndef lint
  172.         else if (!(s = fbminstr((unsigned char*)s,
  173.           (unsigned char*)strend, spat->spat_short)))
  174.             goto nope;
  175. #endif
  176.         else if (spat->spat_flags & SPAT_ALL)
  177.             goto yup;
  178.         if (s && spat->spat_regexp->regback >= 0) {
  179.             ++spat->spat_short->str_u.str_useful;
  180.             s -= spat->spat_regexp->regback;
  181.             if (s < t)
  182.             s = t;
  183.         }
  184.         else
  185.             s = t;
  186.         }
  187.         else if (!multiline && (*spat->spat_short->str_ptr != *s ||
  188.           bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
  189.         goto nope;
  190.         if (--spat->spat_short->str_u.str_useful < 0) {
  191.         str_free(spat->spat_short);
  192.         spat->spat_short = Nullstr;    /* opt is being useless */
  193.         }
  194.     }
  195.     if (!spat->spat_regexp->nparens && !global)
  196.         gimme = G_SCALAR;            /* accidental array context? */
  197.     if (regexec(spat->spat_regexp, s, strend, t, 0,
  198.       srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
  199.       safebase)) {
  200.         if (spat->spat_regexp->subbase || global)
  201.         curspat = spat;
  202.         lastspat = spat;
  203.         if (spat->spat_flags & SPAT_ONCE)
  204.         spat->spat_flags |= SPAT_USED;
  205.         goto gotcha;
  206.     }
  207.     else {
  208.         if (global)
  209.         spat->spat_regexp->startp[0] = Nullch;
  210.         if (gimme == G_ARRAY)
  211.         return sp;
  212.         str_sset(str,&str_no);
  213.         STABSET(str);
  214.         st[++sp] = str;
  215.         return sp;
  216.     }
  217.     }
  218.     /*NOTREACHED*/
  219.  
  220.   gotcha:
  221.     if (gimme == G_ARRAY) {
  222.     int iters, i, len;
  223.  
  224.     iters = spat->spat_regexp->nparens;
  225.     if (global && !iters)
  226.         i = 1;
  227.     else
  228.         i = 0;
  229.     if (sp + iters + i >= stack->ary_max) {
  230.         astore(stack,sp + iters + i, Nullstr);
  231.         st = stack->ary_array;        /* possibly realloced */
  232.     }
  233.  
  234.     for (i = !i; i <= iters; i++) {
  235.         st[++sp] = str_mortal(&str_no);
  236.         if (s = spat->spat_regexp->startp[i]) {
  237.         len = spat->spat_regexp->endp[i] - s;
  238.         if (len > 0)
  239.             str_nset(st[sp],s,len);
  240.         }
  241.     }
  242.     if (global)
  243.         goto play_it_again;
  244.     return sp;
  245.     }
  246.     else {
  247.     str_sset(str,&str_yes);
  248.     STABSET(str);
  249.     st[++sp] = str;
  250.     return sp;
  251.     }
  252.  
  253. yup:
  254.     ++spat->spat_short->str_u.str_useful;
  255.     lastspat = spat;
  256.     if (spat->spat_flags & SPAT_ONCE)
  257.     spat->spat_flags |= SPAT_USED;
  258.     if (global) {
  259.     spat->spat_regexp->startp[0] = s;
  260.     spat->spat_regexp->endp[0] = s + spat->spat_short->str_cur;
  261.     curspat = spat;
  262.     goto gotcha;
  263.     }
  264.     if (sawampersand) {
  265.     char *tmps;
  266.  
  267.     if (spat->spat_regexp->subbase)
  268.         Safefree(spat->spat_regexp->subbase);
  269.     tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t);
  270.     spat->spat_regexp->subbeg = tmps;
  271.     spat->spat_regexp->subend = tmps + (strend-t);
  272.     tmps = spat->spat_regexp->startp[0] = tmps + (s - t);
  273.     spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur;
  274.     curspat = spat;
  275.     }
  276.     str_sset(str,&str_yes);
  277.     STABSET(str);
  278.     st[++sp] = str;
  279.     return sp;
  280.  
  281. nope:
  282.     spat->spat_regexp->startp[0] = Nullch;
  283.     ++spat->spat_short->str_u.str_useful;
  284.     if (global)
  285.     spat->spat_regexp->startp[0] = Nullch;
  286.     if (gimme == G_ARRAY)
  287.     return sp;
  288.     str_sset(str,&str_no);
  289.     STABSET(str);
  290.     st[++sp] = str;
  291.     return sp;
  292. }
  293.  
  294. #ifdef BUGGY_MSC
  295.  #pragma intrinsic(memcmp)
  296. #endif /* BUGGY_MSC */
  297.  
  298. int
  299. do_split(str,spat,limit,gimme,arglast)
  300. STR *str;
  301. register SPAT *spat;
  302. register int limit;
  303. int gimme;
  304. int *arglast;
  305. {
  306.     register ARRAY *ary = stack;
  307.     STR **st = ary->ary_array;
  308.     register int sp = arglast[0] + 1;
  309.     register char *s = str_get(st[sp]);
  310.     char *strend = s + st[sp--]->str_cur;
  311.     register STR *dstr;
  312.     register char *m;
  313.     int iters = 0;
  314.     int maxiters = (strend - s) + 10;
  315.     int i;
  316.     char *orig;
  317.     int origlimit = limit;
  318.     int realarray = 0;
  319.  
  320.     if (!spat || !s)
  321.     fatal("panic: do_split");
  322.     else if (spat->spat_runtime) {
  323.     nointrp = "|)";
  324.     sp = eval(spat->spat_runtime,G_SCALAR,sp);
  325.     st = stack->ary_array;
  326.     m = str_get(dstr = st[sp--]);
  327.     nointrp = "";
  328.     if (*m == ' ' && dstr->str_cur == 1) {
  329.         str_set(dstr,"\\s+");
  330.         m = dstr->str_ptr;
  331.         spat->spat_flags |= SPAT_SKIPWHITE;
  332.     }
  333.     if (spat->spat_regexp) {
  334.         regfree(spat->spat_regexp);
  335.         spat->spat_regexp = Null(REGEXP*);    /* avoid possible double free */
  336.     }
  337.     spat->spat_regexp = regcomp(m,m+dstr->str_cur,
  338.         spat->spat_flags & SPAT_FOLD);
  339.     if (spat->spat_flags & SPAT_KEEP ||
  340.         (spat->spat_runtime->arg_type == O_ITEM &&
  341.           (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) {
  342.         arg_free(spat->spat_runtime);    /* it won't change, so */
  343.         spat->spat_runtime = Nullarg;    /* no point compiling again */
  344.     }
  345.     }
  346. #ifdef DEBUGGING
  347.     if (debug & 8) {
  348.     deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
  349.     }
  350. #endif
  351.     ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
  352.     if (ary && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) {
  353.     realarray = 1;
  354.     if (!(ary->ary_flags & ARF_REAL)) {
  355.         ary->ary_flags |= ARF_REAL;
  356.         for (i = ary->ary_fill; i >= 0; i--)
  357.         ary->ary_array[i] = Nullstr;    /* don't free mere refs */
  358.     }
  359.     ary->ary_fill = -1;
  360.     sp = -1;    /* temporarily switch stacks */
  361.     }
  362.     else
  363.     ary = stack;
  364.     orig = s;
  365.     if (spat->spat_flags & SPAT_SKIPWHITE) {
  366.     while (isascii(*s) && isspace(*s))
  367.         s++;
  368.     }
  369.     if (!limit)
  370.     limit = maxiters + 2;
  371.     if (strEQ("\\s+",spat->spat_regexp->precomp)) {
  372.     while (--limit) {
  373.         for (m = s; m < strend && !(isascii(*m)&&isspace(*m)); m++) ;
  374.         if (m >= strend)
  375.         break;
  376.         dstr = Str_new(30,m-s);
  377.         str_nset(dstr,s,m-s);
  378.         if (!realarray)
  379.         str_2mortal(dstr);
  380.         (void)astore(ary, ++sp, dstr);
  381.         for (s = m + 1; s < strend && isascii(*s) && isspace(*s); s++) ;
  382.     }
  383.     }
  384.     else if (strEQ("^",spat->spat_regexp->precomp)) {
  385.     while (--limit) {
  386.         for (m = s; m < strend && *m != '\n'; m++) ;
  387.         m++;
  388.         if (m >= strend)
  389.         break;
  390.         dstr = Str_new(30,m-s);
  391.         str_nset(dstr,s,m-s);
  392.         if (!realarray)
  393.         str_2mortal(dstr);
  394.         (void)astore(ary, ++sp, dstr);
  395.         s = m;
  396.     }
  397.     }
  398.     else if (spat->spat_short) {
  399.     i = spat->spat_short->str_cur;
  400.     if (i == 1) {
  401.         int fold = (spat->spat_flags & SPAT_FOLD);
  402.  
  403.         i = *spat->spat_short->str_ptr;
  404.         if (fold && isupper(i))
  405.         i = tolower(i);
  406.         while (--limit) {
  407.         if (fold) {
  408.             for ( m = s;
  409.               m < strend && *m != i &&
  410.                 (!isupper(*m) || tolower(*m) != i);
  411.               m++)
  412.             ;
  413.         }
  414.         else
  415.             for (m = s; m < strend && *m != i; m++) ;
  416.         if (m >= strend)
  417.             break;
  418.         dstr = Str_new(30,m-s);
  419.         str_nset(dstr,s,m-s);
  420.         if (!realarray)
  421.             str_2mortal(dstr);
  422.         (void)astore(ary, ++sp, dstr);
  423.         s = m + 1;
  424.         }
  425.     }
  426.     else {
  427. #ifndef lint
  428.         while (s < strend && --limit &&
  429.           (m=fbminstr((unsigned char*)s, (unsigned char*)strend,
  430.             spat->spat_short)) )
  431. #endif
  432.         {
  433.         dstr = Str_new(31,m-s);
  434.         str_nset(dstr,s,m-s);
  435.         if (!realarray)
  436.             str_2mortal(dstr);
  437.         (void)astore(ary, ++sp, dstr);
  438.         s = m + i;
  439.         }
  440.     }
  441.     }
  442.     else {
  443.     maxiters += (strend - s) * spat->spat_regexp->nparens;
  444.     while (s < strend && --limit &&
  445.         regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) {
  446.         if (spat->spat_regexp->subbase
  447.           && spat->spat_regexp->subbase != orig) {
  448.         m = s;
  449.         s = orig;
  450.         orig = spat->spat_regexp->subbase;
  451.         s = orig + (m - s);
  452.         strend = s + (strend - m);
  453.         }
  454.         m = spat->spat_regexp->startp[0];
  455.         dstr = Str_new(32,m-s);
  456.         str_nset(dstr,s,m-s);
  457.         if (!realarray)
  458.         str_2mortal(dstr);
  459.         (void)astore(ary, ++sp, dstr);
  460.         if (spat->spat_regexp->nparens) {
  461.         for (i = 1; i <= spat->spat_regexp->nparens; i++) {
  462.             s = spat->spat_regexp->startp[i];
  463.             m = spat->spat_regexp->endp[i];
  464.             dstr = Str_new(33,m-s);
  465.             str_nset(dstr,s,m-s);
  466.             if (!realarray)
  467.             str_2mortal(dstr);
  468.             (void)astore(ary, ++sp, dstr);
  469.         }
  470.         }
  471.         s = spat->spat_regexp->endp[0];
  472.     }
  473.     }
  474.     if (realarray)
  475.     iters = sp + 1;
  476.     else
  477.     iters = sp - arglast[0];
  478.     if (iters > maxiters)
  479.     fatal("Split loop");
  480.     if (s < strend || origlimit) {    /* keep field after final delim? */
  481.     dstr = Str_new(34,strend-s);
  482.     str_nset(dstr,s,strend-s);
  483.     if (!realarray)
  484.         str_2mortal(dstr);
  485.     (void)astore(ary, ++sp, dstr);
  486.     iters++;
  487.     }
  488.     else {
  489. #ifndef I286x
  490.     while (iters > 0 && ary->ary_array[sp]->str_cur == 0)
  491.         iters--,sp--;
  492. #else
  493.     char *zaps;
  494.     int   zapb;
  495.  
  496.     if (iters > 0) {
  497.         zaps = str_get(afetch(ary,sp,FALSE));
  498.         zapb = (int) *zaps;
  499.     }
  500.  
  501.     while (iters > 0 && (!zapb)) {
  502.         iters--,sp--;
  503.         if (iters > 0) {
  504.         zaps = str_get(afetch(ary,iters-1,FALSE));
  505.         zapb = (int) *zaps;
  506.         }
  507.     }
  508. #endif
  509.     }
  510.     if (realarray) {
  511.     ary->ary_fill = sp;
  512.     if (gimme == G_ARRAY) {
  513.         sp++;
  514.         astore(stack, arglast[0] + 1 + sp, Nullstr);
  515.         Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*);
  516.         return arglast[0] + sp;
  517.     }
  518.     }
  519.     else {
  520.     if (gimme == G_ARRAY)
  521.         return sp;
  522.     }
  523.     sp = arglast[0] + 1;
  524.     str_numset(str,(double)iters);
  525.     STABSET(str);
  526.     st[sp] = str;
  527.     return sp;
  528. }
  529.  
  530. int
  531. do_unpack(str,gimme,arglast)
  532. STR *str;
  533. int gimme;
  534. int *arglast;
  535. {
  536.     STR **st = stack->ary_array;
  537.     register int sp = arglast[0] + 1;
  538.     register char *pat = str_get(st[sp++]);
  539.     register char *s = str_get(st[sp]);
  540.     char *strend = s + st[sp--]->str_cur;
  541.     char *strbeg = s;
  542.     register char *patend = pat + st[sp]->str_cur;
  543.     int datumtype;
  544.     register int len;
  545.     register int bits;
  546.  
  547.     /* These must not be in registers: */
  548.     short ashort;
  549.     int aint;
  550.     long along;
  551.     unsigned short aushort;
  552.     unsigned int auint;
  553.     unsigned long aulong;
  554.     char *aptr;
  555.     float afloat;
  556.     double adouble;
  557.     int checksum = 0;
  558.     unsigned long culong;
  559.     double cdouble;
  560.  
  561.     if (gimme != G_ARRAY) {        /* arrange to do first one only */
  562.     for (patend = pat; !isalpha(*patend); patend++);
  563.     if (index("aAbBhH", *patend) || *pat == '%') {
  564.         patend++;
  565.         while (isdigit(*patend) || *patend == '*')
  566.         patend++;
  567.     }
  568.     else
  569.         patend++;
  570.     }
  571.     sp--;
  572.     while (pat < patend) {
  573.       reparse:
  574.     datumtype = *pat++;
  575.     if (pat >= patend)
  576.         len = 1;
  577.     else if (*pat == '*') {
  578.         len = strend - strbeg;    /* long enough */
  579.         pat++;
  580.     }
  581.     else if (isdigit(*pat)) {
  582.         len = *pat++ - '0';
  583.         while (isdigit(*pat))
  584.         len = (len * 10) + (*pat++ - '0');
  585.     }
  586.     else
  587.         len = (datumtype != '@');
  588.     switch(datumtype) {
  589.     default:
  590.         break;
  591.     case '%':
  592.         if (len == 1 && pat[-1] != '1')
  593.         len = 16;
  594.         checksum = len;
  595.         culong = 0;
  596.         cdouble = 0;
  597.         if (pat < patend)
  598.         goto reparse;
  599.         break;
  600.     case '@':
  601.         if (len > strend - s)
  602.         fatal("@ outside of string");
  603.         s = strbeg + len;
  604.         break;
  605.     case 'X':
  606.         if (len > s - strbeg)
  607.         fatal("X outside of string");
  608.         s -= len;
  609.         break;
  610.     case 'x':
  611.         if (len > strend - s)
  612.         fatal("x outside of string");
  613.         s += len;
  614.         break;
  615.     case 'A':
  616.     case 'a':
  617.         if (len > strend - s)
  618.         len = strend - s;
  619.         if (checksum)
  620.         goto uchar_checksum;
  621.         str = Str_new(35,len);
  622.         str_nset(str,s,len);
  623.         s += len;
  624.         if (datumtype == 'A') {
  625.         aptr = s;    /* borrow register */
  626.         s = str->str_ptr + len - 1;
  627.         while (s >= str->str_ptr && (!*s || (isascii(*s)&&isspace(*s))))
  628.             s--;
  629.         *++s = '\0';
  630.         str->str_cur = s - str->str_ptr;
  631.         s = aptr;    /* unborrow register */
  632.         }
  633.         (void)astore(stack, ++sp, str_2mortal(str));
  634.         break;
  635.     case 'B':
  636.     case 'b':
  637.         if (pat[-1] == '*' || len > (strend - s) * 8)
  638.         len = (strend - s) * 8;
  639.         str = Str_new(35, len + 1);
  640.         str->str_cur = len;
  641.         str->str_pok = 1;
  642.         aptr = pat;            /* borrow register */
  643.         pat = str->str_ptr;
  644.         if (datumtype == 'b') {
  645.         aint = len;
  646.         for (len = 0; len < aint; len++) {
  647.             if (len & 7)
  648.             bits >>= 1;
  649.             else
  650.             bits = *s++;
  651.             *pat++ = '0' + (bits & 1);
  652.         }
  653.         }
  654.         else {
  655.         aint = len;
  656.         for (len = 0; len < aint; len++) {
  657.             if (len & 7)
  658.             bits <<= 1;
  659.             else
  660.             bits = *s++;
  661.             *pat++ = '0' + ((bits & 128) != 0);
  662.         }
  663.         }
  664.         *pat = '\0';
  665.         pat = aptr;            /* unborrow register */
  666.         (void)astore(stack, ++sp, str_2mortal(str));
  667.         break;
  668.     case 'H':
  669.     case 'h':
  670.         if (pat[-1] == '*' || len > (strend - s) * 2)
  671.         len = (strend - s) * 2;
  672.         str = Str_new(35, len + 1);
  673.         str->str_cur = len;
  674.         str->str_pok = 1;
  675.         aptr = pat;            /* borrow register */
  676.         pat = str->str_ptr;
  677.         if (datumtype == 'h') {
  678.         aint = len;
  679.         for (len = 0; len < aint; len++) {
  680.             if (len & 1)
  681.             bits >>= 4;
  682.             else
  683.             bits = *s++;
  684.             *pat++ = hexdigit[bits & 15];
  685.         }
  686.         }
  687.         else {
  688.         aint = len;
  689.         for (len = 0; len < aint; len++) {
  690.             if (len & 1)
  691.             bits <<= 4;
  692.             else
  693.             bits = *s++;
  694.             *pat++ = hexdigit[(bits >> 4) & 15];
  695.         }
  696.         }
  697.         *pat = '\0';
  698.         pat = aptr;            /* unborrow register */
  699.         (void)astore(stack, ++sp, str_2mortal(str));
  700.         break;
  701.     case 'c':
  702.         if (len > strend - s)
  703.         len = strend - s;
  704.         if (checksum) {
  705.         while (len-- > 0) {
  706.             aint = *s++;
  707.             if (aint >= 128)    /* fake up signed chars */
  708.             aint -= 256;
  709.             culong += aint;
  710.         }
  711.         }
  712.         else {
  713.         while (len-- > 0) {
  714.             aint = *s++;
  715.             if (aint >= 128)    /* fake up signed chars */
  716.             aint -= 256;
  717.             str = Str_new(36,0);
  718.             str_numset(str,(double)aint);
  719.             (void)astore(stack, ++sp, str_2mortal(str));
  720.         }
  721.         }
  722.         break;
  723.     case 'C':
  724.         if (len > strend - s)
  725.         len = strend - s;
  726.         if (checksum) {
  727.           uchar_checksum:
  728.         while (len-- > 0) {
  729.             auint = *s++ & 255;
  730.             culong += auint;
  731.         }
  732.         }
  733.         else {
  734.         while (len-- > 0) {
  735.             auint = *s++ & 255;
  736.             str = Str_new(37,0);
  737.             str_numset(str,(double)auint);
  738.             (void)astore(stack, ++sp, str_2mortal(str));
  739.         }
  740.         }
  741.         break;
  742.     case 's':
  743.         along = (strend - s) / sizeof(short);
  744.         if (len > along)
  745.         len = along;
  746.         if (checksum) {
  747.         while (len-- > 0) {
  748.             bcopy(s,(char*)&ashort,sizeof(short));
  749.             s += sizeof(short);
  750.             culong += ashort;
  751.         }
  752.         }
  753.         else {
  754.         while (len-- > 0) {
  755.             bcopy(s,(char*)&ashort,sizeof(short));
  756.             s += sizeof(short);
  757.             str = Str_new(38,0);
  758.             str_numset(str,(double)ashort);
  759.             (void)astore(stack, ++sp, str_2mortal(str));
  760.         }
  761.         }
  762.         break;
  763.     case 'n':
  764.     case 'S':
  765.         along = (strend - s) / sizeof(unsigned short);
  766.         if (len > along)
  767.         len = along;
  768.         if (checksum) {
  769.         while (len-- > 0) {
  770.             bcopy(s,(char*)&aushort,sizeof(unsigned short));
  771.             s += sizeof(unsigned short);
  772. #ifdef HAS_NTOHS
  773.             if (datumtype == 'n')
  774.             aushort = ntohs(aushort);
  775. #endif
  776.             culong += aushort;
  777.         }
  778.         }
  779.         else {
  780.         while (len-- > 0) {
  781.             bcopy(s,(char*)&aushort,sizeof(unsigned short));
  782.             s += sizeof(unsigned short);
  783.             str = Str_new(39,0);
  784. #ifdef HAS_NTOHS
  785.             if (datumtype == 'n')
  786.             aushort = ntohs(aushort);
  787. #endif
  788.             str_numset(str,(double)aushort);
  789.             (void)astore(stack, ++sp, str_2mortal(str));
  790.         }
  791.         }
  792.         break;
  793.     case 'i':
  794.         along = (strend - s) / sizeof(int);
  795.         if (len > along)
  796.         len = along;
  797.         if (checksum) {
  798.         while (len-- > 0) {
  799.             bcopy(s,(char*)&aint,sizeof(int));
  800.             s += sizeof(int);
  801.             if (checksum > 32)
  802.             cdouble += (double)aint;
  803.             else
  804.             culong += aint;
  805.         }
  806.         }
  807.         else {
  808.         while (len-- > 0) {
  809.             bcopy(s,(char*)&aint,sizeof(int));
  810.             s += sizeof(int);
  811.             str = Str_new(40,0);
  812.             str_numset(str,(double)aint);
  813.             (void)astore(stack, ++sp, str_2mortal(str));
  814.         }
  815.         }
  816.         break;
  817.     case 'I':
  818.         along = (strend - s) / sizeof(unsigned int);
  819.         if (len > along)
  820.         len = along;
  821.         if (checksum) {
  822.         while (len-- > 0) {
  823.             bcopy(s,(char*)&auint,sizeof(unsigned int));
  824.             s += sizeof(unsigned int);
  825.             if (checksum > 32)
  826.             cdouble += (double)auint;
  827.             else
  828.             culong += auint;
  829.         }
  830.         }
  831.         else {
  832.         while (len-- > 0) {
  833.             bcopy(s,(char*)&auint,sizeof(unsigned int));
  834.             s += sizeof(unsigned int);
  835.             str = Str_new(41,0);
  836.             str_numset(str,(double)auint);
  837.             (void)astore(stack, ++sp, str_2mortal(str));
  838.         }
  839.         }
  840.         break;
  841.     case 'l':
  842.         along = (strend - s) / sizeof(long);
  843.         if (len > along)
  844.         len = along;
  845.         if (checksum) {
  846.         while (len-- > 0) {
  847.             bcopy(s,(char*)&along,sizeof(long));
  848.             s += sizeof(long);
  849.             if (checksum > 32)
  850.             cdouble += (double)along;
  851.             else
  852.             culong += along;
  853.         }
  854.         }
  855.         else {
  856.         while (len-- > 0) {
  857.             bcopy(s,(char*)&along,sizeof(long));
  858.             s += sizeof(long);
  859.             str = Str_new(42,0);
  860.             str_numset(str,(double)along);
  861.             (void)astore(stack, ++sp, str_2mortal(str));
  862.         }
  863.         }
  864.         break;
  865.     case 'N':
  866.     case 'L':
  867.         along = (strend - s) / sizeof(unsigned long);
  868.         if (len > along)
  869.         len = along;
  870.         if (checksum) {
  871.         while (len-- > 0) {
  872.             bcopy(s,(char*)&aulong,sizeof(unsigned long));
  873.             s += sizeof(unsigned long);
  874. #ifdef HAS_NTOHL
  875.             if (datumtype == 'N')
  876.             aulong = ntohl(aulong);
  877. #endif
  878.             if (checksum > 32)
  879.             cdouble += (double)aulong;
  880.             else
  881.             culong += aulong;
  882.         }
  883.         }
  884.         else {
  885.         while (len-- > 0) {
  886.             bcopy(s,(char*)&aulong,sizeof(unsigned long));
  887.             s += sizeof(unsigned long);
  888.             str = Str_new(43,0);
  889. #ifdef HAS_NTOHL
  890.             if (datumtype == 'N')
  891.             aulong = ntohl(aulong);
  892. #endif
  893.             str_numset(str,(double)aulong);
  894.             (void)astore(stack, ++sp, str_2mortal(str));
  895.         }
  896.         }
  897.         break;
  898.     case 'p':
  899.         along = (strend - s) / sizeof(char*);
  900.         if (len > along)
  901.         len = along;
  902.         while (len-- > 0) {
  903.         if (sizeof(char*) > strend - s)
  904.             break;
  905.         else {
  906.             bcopy(s,(char*)&aptr,sizeof(char*));
  907.             s += sizeof(char*);
  908.         }
  909.         str = Str_new(44,0);
  910.         if (aptr)
  911.             str_set(str,aptr);
  912.         (void)astore(stack, ++sp, str_2mortal(str));
  913.         }
  914.         break;
  915.     /* float and double added gnb@melba.bby.oz.au 22/11/89 */
  916.     case 'f':
  917.     case 'F':
  918.         along = (strend - s) / sizeof(float);
  919.         if (len > along)
  920.         len = along;
  921.         if (checksum) {
  922.         while (len-- > 0) {
  923.             bcopy(s, (char *)&afloat, sizeof(float));
  924.             s += sizeof(float);
  925.             cdouble += afloat;
  926.         }
  927.         }
  928.         else {
  929.         while (len-- > 0) {
  930.             bcopy(s, (char *)&afloat, sizeof(float));
  931.             s += sizeof(float);
  932.             str = Str_new(47, 0);
  933.             str_numset(str, (double)afloat);
  934.             (void)astore(stack, ++sp, str_2mortal(str));
  935.         }
  936.         }
  937.         break;
  938.     case 'd':
  939.     case 'D':
  940.         along = (strend - s) / sizeof(double);
  941.         if (len > along)
  942.         len = along;
  943.         if (checksum) {
  944.         while (len-- > 0) {
  945.             bcopy(s, (char *)&adouble, sizeof(double));
  946.             s += sizeof(double);
  947.             cdouble += adouble;
  948.         }
  949.         }
  950.         else {
  951.         while (len-- > 0) {
  952.             bcopy(s, (char *)&adouble, sizeof(double));
  953.             s += sizeof(double);
  954.             str = Str_new(48, 0);
  955.             str_numset(str, (double)adouble);
  956.             (void)astore(stack, ++sp, str_2mortal(str));
  957.         }
  958.         }
  959.         break;
  960.     case 'u':
  961.         along = (strend - s) * 3 / 4;
  962.         str = Str_new(42,along);
  963.         while (s < strend && *s > ' ' && *s < 'a') {
  964.         int a,b,c,d;
  965.         char hunk[4];
  966.  
  967.         hunk[3] = '\0';
  968.         len = (*s++ - ' ') & 077;
  969.         while (len > 0) {
  970.             if (s < strend && *s >= ' ')
  971.             a = (*s++ - ' ') & 077;
  972.             else
  973.             a = 0;
  974.             if (s < strend && *s >= ' ')
  975.             b = (*s++ - ' ') & 077;
  976.             else
  977.             b = 0;
  978.             if (s < strend && *s >= ' ')
  979.             c = (*s++ - ' ') & 077;
  980.             else
  981.             c = 0;
  982.             if (s < strend && *s >= ' ')
  983.             d = (*s++ - ' ') & 077;
  984.             else
  985.             d = 0;
  986.             hunk[0] = a << 2 | b >> 4;
  987.             hunk[1] = b << 4 | c >> 2;
  988.             hunk[2] = c << 6 | d;
  989.             str_ncat(str,hunk, len > 3 ? 3 : len);
  990.             len -= 3;
  991.         }
  992.         if (*s == '\n')
  993.             s++;
  994.         else if (s[1] == '\n')        /* possible checksum byte */
  995.             s += 2;
  996.         }
  997.         (void)astore(stack, ++sp, str_2mortal(str));
  998.         break;
  999.     }
  1000.     if (checksum) {
  1001.         str = Str_new(42,0);
  1002.         if (index("fFdD", datumtype) ||
  1003.           (checksum > 32 && index("iIlLN", datumtype)) ) {
  1004.         double modf();
  1005.         double trouble;
  1006.  
  1007.         adouble = 1.0;
  1008.         while (checksum >= 16) {
  1009.             checksum -= 16;
  1010.             adouble *= 65536.0;
  1011.         }
  1012.         while (checksum >= 4) {
  1013.             checksum -= 4;
  1014.             adouble *= 16.0;
  1015.         }
  1016.         while (checksum--)
  1017.             adouble *= 2.0;
  1018.         along = (1 << checksum) - 1;
  1019.         while (cdouble < 0.0)
  1020.             cdouble += adouble;
  1021.         cdouble = modf(cdouble / adouble, &trouble) * adouble;
  1022.         str_numset(str,cdouble);
  1023.         }
  1024.         else {
  1025.         if (checksum < 32) {
  1026.             along = (1 << checksum) - 1;
  1027.             culong &= (unsigned long)along;
  1028.         }
  1029.         str_numset(str,(double)culong);
  1030.         }
  1031.         (void)astore(stack, ++sp, str_2mortal(str));
  1032.         checksum = 0;
  1033.     }
  1034.     }
  1035.     return sp;
  1036. }
  1037.  
  1038. int
  1039. do_slice(stab,str,numarray,lval,gimme,arglast)
  1040. STAB *stab;
  1041. STR *str;
  1042. int numarray;
  1043. int lval;
  1044. int gimme;
  1045. int *arglast;
  1046. {
  1047.     register STR **st = stack->ary_array;
  1048.     register int sp = arglast[1];
  1049.     register int max = arglast[2];
  1050.     register char *tmps;
  1051.     register int len;
  1052.     register int magic = 0;
  1053.     register ARRAY *ary;
  1054.     register HASH *hash;
  1055.     int oldarybase = arybase;
  1056.  
  1057.     if (numarray) {
  1058.     if (numarray == 2) {        /* a slice of a LIST */
  1059.         ary = stack;
  1060.         ary->ary_fill = arglast[3];
  1061.         arybase -= max + 1;
  1062.         st[sp] = str;        /* make stack size available */
  1063.         str_numset(str,(double)(sp - 1));
  1064.     }
  1065.     else
  1066.         ary = stab_array(stab);    /* a slice of an array */
  1067.     }
  1068.     else {
  1069.     if (lval) {
  1070.         if (stab == envstab)
  1071.         magic = 'E';
  1072.         else if (stab == sigstab)
  1073.         magic = 'S';
  1074. #ifdef SOME_DBM
  1075.         else if (stab_hash(stab)->tbl_dbm)
  1076.         magic = 'D';
  1077. #endif /* SOME_DBM */
  1078.     }
  1079.     hash = stab_hash(stab);        /* a slice of an associative array */
  1080.     }
  1081.  
  1082.     if (gimme == G_ARRAY) {
  1083.     if (numarray) {
  1084.         while (sp < max) {
  1085.         if (st[++sp]) {
  1086.             st[sp-1] = afetch(ary,
  1087.               ((int)str_gnum(st[sp])) - arybase, lval);
  1088.         }
  1089.         else
  1090.             st[sp-1] = &str_undef;
  1091.         }
  1092.     }
  1093.     else {
  1094.         while (sp < max) {
  1095.         if (st[++sp]) {
  1096.             tmps = str_get(st[sp]);
  1097.             len = st[sp]->str_cur;
  1098.             st[sp-1] = hfetch(hash,tmps,len, lval);
  1099.             if (magic)
  1100.             str_magic(st[sp-1],stab,magic,tmps,len);
  1101.         }
  1102.         else
  1103.             st[sp-1] = &str_undef;
  1104.         }
  1105.     }
  1106.     sp--;
  1107.     }
  1108.     else {
  1109.     if (numarray) {
  1110.         if (st[max])
  1111.         st[sp] = afetch(ary,
  1112.           ((int)str_gnum(st[max])) - arybase, lval);
  1113.         else
  1114.         st[sp] = &str_undef;
  1115.     }
  1116.     else {
  1117.         if (st[max]) {
  1118.         tmps = str_get(st[max]);
  1119.         len = st[max]->str_cur;
  1120.         st[sp] = hfetch(hash,tmps,len, lval);
  1121.         if (magic)
  1122.             str_magic(st[sp],stab,magic,tmps,len);
  1123.         }
  1124.         else
  1125.         st[sp] = &str_undef;
  1126.     }
  1127.     }
  1128.     arybase = oldarybase;
  1129.     return sp;
  1130. }
  1131.  
  1132. int
  1133. do_splice(ary,gimme,arglast)
  1134. register ARRAY *ary;
  1135. int gimme;
  1136. int *arglast;
  1137. {
  1138.     register STR **st = stack->ary_array;
  1139.     register int sp = arglast[1];
  1140.     int max = arglast[2] + 1;
  1141.     register STR **src;
  1142.     register STR **dst;
  1143.     register int i;
  1144.     register int offset;
  1145.     register int length;
  1146.     int newlen;
  1147.     int after;
  1148.     int diff;
  1149.     STR **tmparyval;
  1150.  
  1151.     if (++sp < max) {
  1152.     offset = ((int)str_gnum(st[sp])) - arybase;
  1153.     if (offset < 0)
  1154.         offset += ary->ary_fill + 1;
  1155.     if (++sp < max) {
  1156.         length = (int)str_gnum(st[sp++]);
  1157.         if (length < 0)
  1158.         length = 0;
  1159.     }
  1160.     else
  1161.         length = ary->ary_max;        /* close enough to infinity */
  1162.     }
  1163.     else {
  1164.     offset = 0;
  1165.     length = ary->ary_max;
  1166.     }
  1167.     if (offset < 0) {
  1168.     length += offset;
  1169.     offset = 0;
  1170.     if (length < 0)
  1171.         length = 0;
  1172.     }
  1173.     if (offset > ary->ary_fill + 1)
  1174.     offset = ary->ary_fill + 1;
  1175.     after = ary->ary_fill + 1 - (offset + length);
  1176.     if (after < 0) {                /* not that much array */
  1177.     length += after;            /* offset+length now in array */
  1178.     after = 0;
  1179.     if (!ary->ary_alloc) {
  1180.         afill(ary,0);
  1181.         afill(ary,-1);
  1182.     }
  1183.     }
  1184.  
  1185.     /* At this point, sp .. max-1 is our new LIST */
  1186.  
  1187.     newlen = max - sp;
  1188.     diff = newlen - length;
  1189.  
  1190.     if (diff < 0) {                /* shrinking the area */
  1191.     if (newlen) {
  1192.         New(451, tmparyval, newlen, STR*);    /* so remember insertion */
  1193.         Copy(st+sp, tmparyval, newlen, STR*);
  1194.     }
  1195.  
  1196.     sp = arglast[0] + 1;
  1197.     if (gimme == G_ARRAY) {            /* copy return vals to stack */
  1198.         if (sp + length >= stack->ary_max) {
  1199.         astore(stack,sp + length, Nullstr);
  1200.         st = stack->ary_array;
  1201.         }
  1202.         Copy(ary->ary_array+offset, st+sp, length, STR*);
  1203.         if (ary->ary_flags & ARF_REAL) {
  1204.         for (i = length, dst = st+sp; i; i--)
  1205.             str_2mortal(*dst++);    /* free them eventualy */
  1206.         }
  1207.         sp += length - 1;
  1208.     }
  1209.     else {
  1210.         st[sp] = ary->ary_array[offset+length-1];
  1211.         if (ary->ary_flags & ARF_REAL)
  1212.         str_2mortal(st[sp]);
  1213.     }
  1214.     ary->ary_fill += diff;
  1215.  
  1216.     /* pull up or down? */
  1217.  
  1218.     if (offset < after) {            /* easier to pull up */
  1219.         if (offset) {            /* esp. if nothing to pull */
  1220.         src = &ary->ary_array[offset-1];
  1221.         dst = src - diff;        /* diff is negative */
  1222.         for (i = offset; i > 0; i--)    /* can't trust Copy */
  1223.             *dst-- = *src--;
  1224.         }
  1225.         Zero(ary->ary_array, -diff, STR*);
  1226.         ary->ary_array -= diff;        /* diff is negative */
  1227.         ary->ary_max += diff;
  1228.     }
  1229.     else {
  1230.         if (after) {            /* anything to pull down? */
  1231.         src = ary->ary_array + offset + length;
  1232.         dst = src + diff;        /* diff is negative */
  1233.         Copy(src, dst, after, STR*);
  1234.         }
  1235.         Zero(&ary->ary_array[ary->ary_fill+1], -diff, STR*);
  1236.                         /* avoid later double free */
  1237.     }
  1238.     if (newlen) {
  1239.         for (src = tmparyval, dst = ary->ary_array + offset;
  1240.           newlen; newlen--) {
  1241.         *dst = Str_new(46,0);
  1242.         str_sset(*dst++,*src++);
  1243.         }
  1244.         Safefree(tmparyval);
  1245.     }
  1246.     }
  1247.     else {                    /* no, expanding (or same) */
  1248.     if (length) {
  1249.         New(452, tmparyval, length, STR*);    /* so remember deletion */
  1250.         Copy(ary->ary_array+offset, tmparyval, length, STR*);
  1251.     }
  1252.  
  1253.     if (diff > 0) {                /* expanding */
  1254.  
  1255.         /* push up or down? */
  1256.  
  1257.         if (offset < after && diff <= ary->ary_array - ary->ary_alloc) {
  1258.         if (offset) {
  1259.             src = ary->ary_array;
  1260.             dst = src - diff;
  1261.             Copy(src, dst, offset, STR*);
  1262.         }
  1263.         ary->ary_array -= diff;        /* diff is positive */
  1264.         ary->ary_max += diff;
  1265.         ary->ary_fill += diff;
  1266.         }
  1267.         else {
  1268.         if (ary->ary_fill + diff >= ary->ary_max)    /* oh, well */
  1269.             astore(ary, ary->ary_fill + diff, Nullstr);
  1270.         else
  1271.             ary->ary_fill += diff;
  1272.         if (after) {
  1273.             dst = ary->ary_array + ary->ary_fill;
  1274.             src = dst - diff;
  1275.             for (i = after; i; i--) {
  1276.             if (*dst)        /* str was hanging around */
  1277.                 str_free(*dst);    /*  after $#foo */
  1278.             *dst-- = *src;
  1279.             *src-- = Nullstr;
  1280.             }
  1281.         }
  1282.         }
  1283.     }
  1284.  
  1285.     for (src = st+sp, dst = ary->ary_array + offset; newlen; newlen--) {
  1286.         *dst = Str_new(46,0);
  1287.         str_sset(*dst++,*src++);
  1288.     }
  1289.     sp = arglast[0] + 1;
  1290.     if (gimme == G_ARRAY) {            /* copy return vals to stack */
  1291.         if (length) {
  1292.         Copy(tmparyval, st+sp, length, STR*);
  1293.         if (ary->ary_flags & ARF_REAL) {
  1294.             for (i = length, dst = st+sp; i; i--)
  1295.             str_2mortal(*dst++);    /* free them eventualy */
  1296.         }
  1297.         Safefree(tmparyval);
  1298.         }
  1299.         sp += length - 1;
  1300.     }
  1301.     else if (length) {
  1302.         st[sp] = tmparyval[length-1];
  1303.         if (ary->ary_flags & ARF_REAL)
  1304.         str_2mortal(st[sp]);
  1305.         Safefree(tmparyval);
  1306.     }
  1307.     else
  1308.         st[sp] = &str_undef;
  1309.     }
  1310.     return sp;
  1311. }
  1312.  
  1313. int
  1314. do_grep(arg,str,gimme,arglast)
  1315. register ARG *arg;
  1316. STR *str;
  1317. int gimme;
  1318. int *arglast;
  1319. {
  1320.     STR **st = stack->ary_array;
  1321.     register int dst = arglast[1];
  1322.     register int src = dst + 1;
  1323.     register int sp = arglast[2];
  1324.     register int i = sp - arglast[1];
  1325.     int oldsave = savestack->ary_fill;
  1326.     SPAT *oldspat = curspat;
  1327.     int oldtmps_base = tmps_base;
  1328.  
  1329.     savesptr(&stab_val(defstab));
  1330.     tmps_base = tmps_max;
  1331.     if ((arg[1].arg_type & A_MASK) != A_EXPR) {
  1332.     arg[1].arg_type &= A_MASK;
  1333.     dehoist(arg,1);
  1334.     arg[1].arg_type |= A_DONT;
  1335.     }
  1336.     arg = arg[1].arg_ptr.arg_arg;
  1337.     while (i-- > 0) {
  1338.     if (st[src])
  1339.         stab_val(defstab) = st[src];
  1340.     else
  1341.         stab_val(defstab) = str_mortal(&str_undef);
  1342.     (void)eval(arg,G_SCALAR,sp);
  1343.     st = stack->ary_array;
  1344.     if (str_true(st[sp+1]))
  1345.         st[dst++] = st[src];
  1346.     src++;
  1347.     curspat = oldspat;
  1348.     }
  1349.     restorelist(oldsave);
  1350.     tmps_base = oldtmps_base;
  1351.     if (gimme != G_ARRAY) {
  1352.     str_numset(str,(double)(dst - arglast[1]));
  1353.     STABSET(str);
  1354.     st[arglast[0]+1] = str;
  1355.     return arglast[0]+1;
  1356.     }
  1357.     return arglast[0] + (dst - arglast[1]);
  1358. }
  1359.  
  1360. int
  1361. do_reverse(arglast)
  1362. int *arglast;
  1363. {
  1364.     STR **st = stack->ary_array;
  1365.     register STR **up = &st[arglast[1]];
  1366.     register STR **down = &st[arglast[2]];
  1367.     register int i = arglast[2] - arglast[1];
  1368.  
  1369.     while (i-- > 0) {
  1370.     *up++ = *down;
  1371.     if (i-- > 0)
  1372.         *down-- = *up;
  1373.     }
  1374.     i = arglast[2] - arglast[1];
  1375.     Copy(down+1,up,i/2,STR*);
  1376.     return arglast[2] - 1;
  1377. }
  1378.  
  1379. int
  1380. do_sreverse(str,arglast)
  1381. STR *str;
  1382. int *arglast;
  1383. {
  1384.     STR **st = stack->ary_array;
  1385.     register char *up;
  1386.     register char *down;
  1387.     register int tmp;
  1388.  
  1389.     str_sset(str,st[arglast[2]]);
  1390.     up = str_get(str);
  1391.     if (str->str_cur > 1) {
  1392.     down = str->str_ptr + str->str_cur - 1;
  1393.     while (down > up) {
  1394.         tmp = *up;
  1395.         *up++ = *down;
  1396.         *down-- = tmp;
  1397.     }
  1398.     }
  1399.     STABSET(str);
  1400.     st[arglast[0]+1] = str;
  1401.     return arglast[0]+1;
  1402. }
  1403.  
  1404. static CMD *sortcmd;
  1405. static HASH *sortstash = Null(HASH*);
  1406. static STAB *firststab = Nullstab;
  1407. static STAB *secondstab = Nullstab;
  1408.  
  1409. int
  1410. do_sort(str,stab,gimme,arglast)
  1411. STR *str;
  1412. STAB *stab;
  1413. int gimme;
  1414. int *arglast;
  1415. {
  1416.     register STR **st = stack->ary_array;
  1417.     int sp = arglast[1];
  1418.     register STR **up;
  1419.     register int max = arglast[2] - sp;
  1420.     register int i;
  1421.     int sortcmp();
  1422.     int sortsub();
  1423.     STR *oldfirst;
  1424.     STR *oldsecond;
  1425.     ARRAY *oldstack;
  1426.     static ARRAY *sortstack = Null(ARRAY*);
  1427.  
  1428.     if (gimme != G_ARRAY) {
  1429.     str_sset(str,&str_undef);
  1430.     STABSET(str);
  1431.     st[sp] = str;
  1432.     return sp;
  1433.     }
  1434.     up = &st[sp];
  1435.     st += sp;        /* temporarily make st point to args */
  1436.     for (i = 1; i <= max; i++) {
  1437.     if (*up = st[i]) {
  1438.         if (!(*up)->str_pok)
  1439.         (void)str_2ptr(*up);
  1440.         else
  1441.         (*up)->str_pok &= ~SP_TEMP;
  1442.         up++;
  1443.     }
  1444.     }
  1445.     st -= sp;
  1446.     max = up - &st[sp];
  1447.     sp--;
  1448.     if (max > 1) {
  1449.     if (stab) {
  1450.         int oldtmps_base = tmps_base;
  1451.  
  1452.         if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
  1453.         fatal("Undefined subroutine \"%s\" in sort", stab_name(stab));
  1454.         if (!sortstack) {
  1455.         sortstack = anew(Nullstab);
  1456.         astore(sortstack, 0, Nullstr);
  1457.         aclear(sortstack);
  1458.         sortstack->ary_flags = 0;
  1459.         }
  1460.         oldstack = stack;
  1461.         stack = sortstack;
  1462.         tmps_base = tmps_max;
  1463.         if (sortstash != stab_stash(stab)) {
  1464.         firststab = stabent("a",TRUE);
  1465.         secondstab = stabent("b",TRUE);
  1466.         sortstash = stab_stash(stab);
  1467.         }
  1468.         oldfirst = stab_val(firststab);
  1469.         oldsecond = stab_val(secondstab);
  1470. #ifndef lint
  1471.         qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub);
  1472. #else
  1473.         qsort(Nullch,max,sizeof(STR*),sortsub);
  1474. #endif
  1475.         stab_val(firststab) = oldfirst;
  1476.         stab_val(secondstab) = oldsecond;
  1477.         tmps_base = oldtmps_base;
  1478.         stack = oldstack;
  1479.     }
  1480. #ifndef lint
  1481.     else
  1482.         qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp);
  1483. #endif
  1484.     }
  1485.     return sp+max;
  1486. }
  1487.  
  1488. int
  1489. sortsub(str1,str2)
  1490. STR **str1;
  1491. STR **str2;
  1492. {
  1493.     stab_val(firststab) = *str1;
  1494.     stab_val(secondstab) = *str2;
  1495.     cmd_exec(sortcmd,G_SCALAR,-1);
  1496.     return (int)str_gnum(*stack->ary_array);
  1497. }
  1498.  
  1499. sortcmp(strp1,strp2)
  1500. STR **strp1;
  1501. STR **strp2;
  1502. {
  1503.     register STR *str1 = *strp1;
  1504.     register STR *str2 = *strp2;
  1505.     int retval;
  1506.  
  1507.     if (str1->str_cur < str2->str_cur) {
  1508.     if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
  1509.         return retval;
  1510.     else
  1511.         return -1;
  1512.     }
  1513.     else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
  1514.     return retval;
  1515.     else if (str1->str_cur == str2->str_cur)
  1516.     return 0;
  1517.     else
  1518.     return 1;
  1519. }
  1520.  
  1521. int
  1522. do_range(gimme,arglast)
  1523. int gimme;
  1524. int *arglast;
  1525. {
  1526.     STR **st = stack->ary_array;
  1527.     register int sp = arglast[0];
  1528.     register int i;
  1529.     register ARRAY *ary = stack;
  1530.     register STR *str;
  1531.     int max;
  1532.  
  1533.     if (gimme != G_ARRAY)
  1534.     fatal("panic: do_range");
  1535.  
  1536.     if (st[sp+1]->str_nok || !st[sp+1]->str_pok ||
  1537.       (looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) {
  1538.     i = (int)str_gnum(st[sp+1]);
  1539.     max = (int)str_gnum(st[sp+2]);
  1540.     while (i <= max) {
  1541.         (void)astore(ary, ++sp, str = str_mortal(&str_no));
  1542.         str_numset(str,(double)i++);
  1543.     }
  1544.     }
  1545.     else {
  1546.     STR *final = str_mortal(st[sp+2]);
  1547.     char *tmps = str_get(final);
  1548.  
  1549.     str = str_mortal(st[sp+1]);
  1550.     while (!str->str_nok && str->str_cur <= final->str_cur &&
  1551.         strNE(str->str_ptr,tmps) ) {
  1552.         (void)astore(ary, ++sp, str);
  1553.         str = str_2mortal(str_smake(str));
  1554.         str_inc(str);
  1555.     }
  1556.     if (strEQ(str->str_ptr,tmps))
  1557.         (void)astore(ary, ++sp, str);
  1558.     }
  1559.     return sp;
  1560. }
  1561.  
  1562. int
  1563. do_repeatary(arglast)
  1564. int *arglast;
  1565. {
  1566.     STR **st = stack->ary_array;
  1567.     register int sp = arglast[0];
  1568.     register int items = arglast[1] - sp;
  1569.     register int count = (int) str_gnum(st[arglast[2]]);
  1570.     register ARRAY *ary = stack;
  1571.     register int i;
  1572.     int max;
  1573.  
  1574.     max = items * count;
  1575.     if (max > 0 && sp + max > stack->ary_max) {
  1576.     astore(stack, sp + max, Nullstr);
  1577.     st = stack->ary_array;
  1578.     }
  1579.     if (count > 1) {
  1580.     for (i = arglast[1]; i > sp; i--)
  1581.         st[i]->str_pok &= ~SP_TEMP;
  1582.     repeatcpy((char*)&st[arglast[1]+1], (char*)&st[sp+1],
  1583.         items * sizeof(STR*), count);
  1584.     }
  1585.     sp += max;
  1586.  
  1587.     return sp;
  1588. }
  1589.  
  1590. int
  1591. do_caller(arg,maxarg,gimme,arglast)
  1592. ARG *arg;
  1593. int maxarg;
  1594. int gimme;
  1595. int *arglast;
  1596. {
  1597.     STR **st = stack->ary_array;
  1598.     register int sp = arglast[0];
  1599.     register CSV *csv = curcsv;
  1600.     STR *str;
  1601.     int count = 0;
  1602.  
  1603.     if (!csv)
  1604.     fatal("There is no caller");
  1605.     if (maxarg)
  1606.     count = (int) str_gnum(st[sp+1]);
  1607.     for (;;) {
  1608.     if (!csv)
  1609.         return sp;
  1610.     if (DBsub && csv->curcsv && csv->curcsv->sub == stab_sub(DBsub))
  1611.         count++;
  1612.     if (!count--)
  1613.         break;
  1614.     csv = csv->curcsv;
  1615.     }
  1616.     if (gimme != G_ARRAY) {
  1617.     STR *str = arg->arg_ptr.arg_str;
  1618.     str_set(str,csv->curcmd->c_stash->tbl_name);
  1619.     STABSET(str);
  1620.     st[++sp] = str;
  1621.     return sp;
  1622.     }
  1623.  
  1624. #ifndef lint
  1625.     (void)astore(stack,++sp,
  1626.       str_2mortal(str_make(csv->curcmd->c_stash->tbl_name,0)) );
  1627.     (void)astore(stack,++sp,
  1628.       str_2mortal(str_make(stab_val(csv->curcmd->c_filestab)->str_ptr,0)) );
  1629.     (void)astore(stack,++sp,
  1630.       str_2mortal(str_nmake((double)csv->curcmd->c_line)) );
  1631.     if (!maxarg)
  1632.     return sp;
  1633.     str = Str_new(49,0);
  1634.     stab_fullname(str, csv->stab);
  1635.     (void)astore(stack,++sp, str_2mortal(str));
  1636.     (void)astore(stack,++sp,
  1637.       str_2mortal(str_nmake((double)csv->hasargs)) );
  1638.     (void)astore(stack,++sp,
  1639.       str_2mortal(str_nmake((double)csv->wantarray)) );
  1640.     if (csv->hasargs) {
  1641.     ARRAY *ary = csv->argarray;
  1642.     STAB *tmpstab;
  1643.  
  1644.     if (!dbargs)
  1645.         dbargs = stab_xarray(aadd(stabent("DB'args", TRUE)));
  1646.     if (dbargs->ary_max < ary->ary_fill)
  1647.         astore(dbargs,ary->ary_fill,Nullstr);
  1648.     Copy(ary->ary_array, dbargs->ary_array, ary->ary_fill+1, STR*);
  1649.     dbargs->ary_fill = ary->ary_fill;
  1650.     }
  1651. #else
  1652.     (void)astore(stack,++sp,
  1653.       str_2mortal(str_make("",0)));
  1654. #endif
  1655.     return sp;
  1656. }
  1657.  
  1658. int
  1659. do_tms(str,gimme,arglast)
  1660. STR *str;
  1661. int gimme;
  1662. int *arglast;
  1663. {
  1664. #ifdef MSDOS
  1665.     return -1;
  1666. #else
  1667.     STR **st = stack->ary_array;
  1668.     register int sp = arglast[0];
  1669.  
  1670.     if (gimme != G_ARRAY) {
  1671.     str_sset(str,&str_undef);
  1672.     STABSET(str);
  1673.     st[++sp] = str;
  1674.     return sp;
  1675.     }
  1676.     (void)times(×buf);
  1677.  
  1678. #ifndef HZ
  1679. #define HZ 60
  1680. #endif
  1681.  
  1682. #ifndef lint
  1683.     (void)astore(stack,++sp,
  1684.       str_2mortal(str_nmake(((double)timesbuf.tms_utime)/HZ)));
  1685.     (void)astore(stack,++sp,
  1686.       str_2mortal(str_nmake(((double)timesbuf.tms_stime)/HZ)));
  1687.     (void)astore(stack,++sp,
  1688.       str_2mortal(str_nmake(((double)timesbuf.tms_cutime)/HZ)));
  1689.     (void)astore(stack,++sp,
  1690.       str_2mortal(str_nmake(((double)timesbuf.tms_cstime)/HZ)));
  1691. #else
  1692.     (void)astore(stack,++sp,
  1693.       str_2mortal(str_nmake(0.0)));
  1694. #endif
  1695.     return sp;
  1696. #endif
  1697. }
  1698.  
  1699. int
  1700. do_time(str,tmbuf,gimme,arglast)
  1701. STR *str;
  1702. struct tm *tmbuf;
  1703. int gimme;
  1704. int *arglast;
  1705. {
  1706.     register ARRAY *ary = stack;
  1707.     STR **st = ary->ary_array;
  1708.     register int sp = arglast[0];
  1709.  
  1710.     if (!tmbuf || gimme != G_ARRAY) {
  1711.     str_sset(str,&str_undef);
  1712.     STABSET(str);
  1713.     st[++sp] = str;
  1714.     return sp;
  1715.     }
  1716.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_sec)));
  1717.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_min)));
  1718.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_hour)));
  1719.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mday)));
  1720.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mon)));
  1721.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_year)));
  1722.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_wday)));
  1723.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_yday)));
  1724.     (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_isdst)));
  1725.     return sp;
  1726. }
  1727.  
  1728. int
  1729. do_kv(str,hash,kv,gimme,arglast)
  1730. STR *str;
  1731. HASH *hash;
  1732. int kv;
  1733. int gimme;
  1734. int *arglast;
  1735. {
  1736.     register ARRAY *ary = stack;
  1737.     STR **st = ary->ary_array;
  1738.     register int sp = arglast[0];
  1739.     int i;
  1740.     register HENT *entry;
  1741.     char *tmps;
  1742.     STR *tmpstr;
  1743.     int dokeys = (kv == O_KEYS || kv == O_HASH);
  1744.     int dovalues = (kv == O_VALUES || kv == O_HASH);
  1745.  
  1746.     if (gimme != G_ARRAY) {
  1747.     str_sset(str,&str_undef);
  1748.     STABSET(str);
  1749.     st[++sp] = str;
  1750.     return sp;
  1751.     }
  1752.     (void)hiterinit(hash);
  1753.     while (entry = hiternext(hash)) {
  1754.     if (dokeys) {
  1755.         tmps = hiterkey(entry,&i);
  1756.         if (!i)
  1757.         tmps = "";
  1758.         (void)astore(ary,++sp,str_2mortal(str_make(tmps,i)));
  1759.     }
  1760.     if (dovalues) {
  1761.         tmpstr = Str_new(45,0);
  1762. #ifdef DEBUGGING
  1763.         if (debug & 8192) {
  1764.         sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
  1765.             hash->tbl_max+1,entry->hent_hash & hash->tbl_max);
  1766.         str_set(tmpstr,buf);
  1767.         }
  1768.         else
  1769. #endif
  1770.         str_sset(tmpstr,hiterval(hash,entry));
  1771.         (void)astore(ary,++sp,str_2mortal(tmpstr));
  1772.     }
  1773.     }
  1774.     return sp;
  1775. }
  1776.  
  1777. int
  1778. do_each(str,hash,gimme,arglast)
  1779. STR *str;
  1780. HASH *hash;
  1781. int gimme;
  1782. int *arglast;
  1783. {
  1784.     STR **st = stack->ary_array;
  1785.     register int sp = arglast[0];
  1786.     static STR *mystrk = Nullstr;
  1787.     HENT *entry = hiternext(hash);
  1788.     int i;
  1789.     char *tmps;
  1790.  
  1791.     if (mystrk) {
  1792.     str_free(mystrk);
  1793.     mystrk = Nullstr;
  1794.     }
  1795.  
  1796.     if (entry) {
  1797.     if (gimme == G_ARRAY) {
  1798.         tmps = hiterkey(entry, &i);
  1799.         if (!i)
  1800.         tmps = "";
  1801.         st[++sp] = mystrk = str_make(tmps,i);
  1802.     }
  1803.     st[++sp] = str;
  1804.     str_sset(str,hiterval(hash,entry));
  1805.     STABSET(str);
  1806.     return sp;
  1807.     }
  1808.     else
  1809.     return sp;
  1810. }
  1811.